home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / prog / grafix2.arj / DEMO.BAS < prev    next >
BASIC Source File  |  1993-11-13  |  26KB  |  820 lines
  1. $LIB IPRINT OFF, GRAPH ON, LPT OFF, COM OFF, FULLFLOAT OFF
  2. DEFINT A-Z
  3. shared greytop, greyleft, greybott,greyright
  4. Shared RedLeft, RedRight, RedTop, RedBott
  5. Shared BlueLeft, BlueRight, BlueTop, BlueBott
  6. Shared YellowLeft, YellowRight, YellowTop, YellowBott
  7. Shared GN, RN, BN
  8. REDIM C(1)
  9. DIM TP$(20)
  10. SHARED TP$()
  11.  
  12. SHELL "PBLOGO.EXE" ' ...........................Jim St.Louis' logo program
  13. SCREEN 12
  14. BLACKOUT  '......................................set color palette to black
  15. RANDOM.VIDEO.EFFECT '...........................................draw pattern
  16. PCMAG '...............................................show pc magazine logo
  17. PALETTE '...................................................activate colors
  18.     CWAIT .05
  19. COPYRIGHT '................................................copyright screen
  20.     CWAIT .05
  21. LOGO '...............................................pb ide screen and logo
  22.     CWAIT .05
  23. INTRO '.....................................................intro paragraph
  24.     CWAIT .1
  25. '' between each statement here, show a mono screen with a step-highlight bar
  26. '' on the source code ???
  27. TSR.TOPIC
  28. ASM.TOPIC
  29. DAT.TOPIC
  30. ARR.TOPIC
  31. MAT.TOPIC
  32. MSC.TOPIC
  33. COM.TOPIC
  34. IDE.TOPIC
  35. HEL.TOPIC
  36. ADD.TOPIC
  37.  
  38.  
  39. ' ++++++++++++++++++++++++++ SUBROUTINES FOLLOW ++++++++++++++++++++++
  40.  
  41.  
  42. SUB SaveScreen12(R$, G$, B$, I$)
  43. DEF SEG = &HA000
  44. OUT &H3CE, 4: OUT &H3CF, 0:B$=PEEK$(0,32000)
  45. OUT &H3CE, 4: OUT &H3CF, 1:G$=PEEK$(0,32000)
  46. OUT &H3CE, 4: OUT &H3CF, 2:R$=PEEK$(0,32000)
  47. OUT &H3CE, 4: OUT &H3CF, 3:I$=PEEK$(0,32000)
  48. OUT &H3CE, 4: OUT &H3CF, 0:
  49. DEF SEG
  50. END SUB
  51.  
  52.  
  53. SUB RestoreScreen12(R$, G$, B$, I$)
  54. DEF SEG = &HA000
  55. OUT &H3C4, 2: OUT &H3C5, 1: POKE$ 0,B$
  56. OUT &H3C4, 2: OUT &H3C5, 2: POKE$ 0,G$
  57. OUT &H3C4, 2: OUT &H3C5, 4: POKE$ 0,R$
  58. OUT &H3C4, 2: OUT &H3C5, 8: POKE$ 0,I$
  59. OUT &H3C4, 2: OUT &H3C5, &HF: DEF SEG
  60. END SUB
  61.  
  62. SUB PUTSCREEN (Fi$)
  63.     OPEN Fi$ FOR OUTPUT AS #11
  64.     DEF SEG = &HA000
  65.     OUT &H3CE, 4: OUT &H3CF, 2:R$=PEEK$(0,32000)
  66.         PRINT #11, R$;
  67.     OUT &H3CE, 4: OUT &H3CF, 1:r$=PEEK$(0,32000)
  68.         PRINT #11, R$;
  69.     OUT &H3CE, 4: OUT &H3CF, 0:r$=PEEK$(0,32000)
  70.         PRINT #11, R$;
  71.     OUT &H3CE, 4: OUT &H3CF, 3:r$=PEEK$(0,32000)
  72.         PRINT #11, R$;
  73.     OUT &H3CE, 4: OUT &H3CF, 0:
  74.     DEF SEG
  75.         CLOSE #11
  76. END SUB
  77.  
  78. SUB GETSCREEN (Fi$)
  79.     OPEN Fi$ FOR BINARY AS #11
  80.         GET$ #11, 32000, R$
  81.         GET$ #11, 32000, G$
  82.         GET$ #11, 32000, B$
  83.         GET$ #11, 32000, I$
  84.         CLOSE #11
  85.     DEF SEG = &HA000
  86.     OUT &H3C4, 2: OUT &H3C5, 1: POKE$ 0,B$
  87.     OUT &H3C4, 2: OUT &H3C5, 2: POKE$ 0,G$
  88.     OUT &H3C4, 2: OUT &H3C5, 4: POKE$ 0,R$
  89.     OUT &H3C4, 2: OUT &H3C5, 8: POKE$ 0,I$
  90.     OUT &H3C4, 2: OUT &H3C5, &HF: DEF SEG
  91. END SUB
  92.  
  93. SUB GETSCREEN2 (Fi$)
  94.     OPEN Fi$ FOR BINARY AS #11
  95.         GET$ #11, 32000, R$
  96.         GET$ #11, 32000, G$
  97.         GET$ #11, 32000, B$
  98.         GET$ #11, 32000, I$
  99.         CLOSE #11
  100.     DEF SEG = &HA000
  101.     OUT &H3C4, 2: OUT &H3C5, 1: POKE$ 2560,B$
  102.         'delay .1
  103.     OUT &H3C4, 2: OUT &H3C5, 2: POKE$ 2560,G$
  104.         'delay .1
  105.     OUT &H3C4, 2: OUT &H3C5, 4: POKE$ 2560,R$
  106.     'delay .1
  107.     OUT &H3C4, 2: OUT &H3C5, 8: POKE$ 2560,I$
  108.     OUT &H3C4, 2: OUT &H3C5, &HF: DEF SEG
  109.  
  110. END SUB
  111.  
  112. SUB GETSCREEN3(Fi$)
  113.     OPEN Fi$ FOR BINARY AS #11
  114.         GET$ #11, 32000, R$:R$=LEFT$(R$,19000)
  115.         GET$ #11, 32000, G$:G$=LEFT$(G$,19000)
  116.         GET$ #11, 32000, B$:B$=LEFT$(B$,19000)
  117.         GET$ #11, 32000, I$:I$=LEFT$(I$,19000)
  118.         CLOSE #11
  119.     DEF SEG = &HA000
  120.     OUT &H3C4, 2: OUT &H3C5, 1: POKE$ 2400,B$
  121.     OUT &H3C4, 2: OUT &H3C5, 2: POKE$ 2400,G$
  122.     OUT &H3C4, 2: OUT &H3C5, 4: POKE$ 2400,R$
  123.     OUT &H3C4, 2: OUT &H3C5, 8: POKE$ 2400,I$
  124.     OUT &H3C4, 2: OUT &H3C5, &HF: DEF SEG
  125. END SUB
  126.  
  127.  
  128. SUB CWAIT (DelayFactor!)
  129.         REDIM s%(20000)
  130.         REDIM c%(9999)
  131.         REDIM d%(9999)
  132.         DEF SEG = VARSEG(c%(0))
  133.         BLOAD "CLOCK.PIC",0
  134.         GET (50,440)-(590,440+C%(1)),s%
  135.  
  136.         LINE (50,440)-(590,440+C%(1)),1,BF
  137.                n=4
  138.         CPRINT 29,10,9,1,"Esc - Abort             SPACEBAR = PAUSE            Any - Next"
  139.           GET (55-n,440)-(55+c%(0),440+c%(1)),d%
  140.         FOR i%=55 TO 590-c%(0) STEP n
  141.           PUT (i%-n,440),d%,PSET
  142.           A$=INKEY$
  143.           IF A$=" " THEN DO:A$=INKEY$:LOOP UNTIL LEN(A$):IF A$=" " THEN A$=""
  144.           IF A$=CHR$(27) THEN END
  145.           'LINE (i%,445)-(i%,465),9
  146.           GET (i%,440)-(i%+c%(0),440+c%(1)),d%
  147.           PUT (i%,440),c%,OR
  148.           DELAY DelayFactor!
  149.       IF LEN(A$) THEN EXIT FOR
  150.     NEXT i
  151.  
  152.         PUT (50,440),s%,PSET
  153.  
  154. END SUB
  155.  
  156. sub Yellowbox(byval y1, byval x1, byval y2,byval x2)
  157. YellowTop=Y1
  158. YellowLeft=X1
  159. YellowBott=Y2
  160. YellowRight=X2
  161. y1=(y1-1)*16-16:y2=(y2-1)*16+16:x1=(x1-1)*8-16:x2=(x2-1)*8+16
  162. fil=7:fg=15:bg=8:dv=5
  163. line(x1+dv,y1+dv)-(x2,y2),fil,bf
  164. for i=0 to dv-1:line(dv+i+x1,(dv+1)+i+y1)-(dv+i+x1,dv-i+y2),fg:next i
  165. for i=0 to dv-1:line(dv-i+x2,(dv+1)+i+y1)-(dv-i+x2,dv-i+y2),bg:next i
  166. for i=0 to dv-1:line(dv+i+x1,dv+i+y1)-(dv-i+x2,dv+i+y1),fg:next i
  167. for i=0 to dv-1:line(dv-i+dv+x1,i+y2+1)-(dv+i-dv+x2,i+y2+1),bg:next i
  168. end sub
  169.  
  170. sub bluebox(byval y1, byval x1, byval y2,byval x2)
  171. BlueTop=Y1
  172. BlueLeft=X1
  173. BlueBott=Y2
  174. BlueRight=X2
  175. y1=(y1-1)*16-16:y2=(y2-1)*16+16:x1=(x1-1)*8-16:x2=(x2-1)*8+16
  176. fil=1:fg=9:bg=8:dv=5
  177. line(x1+dv,y1+dv)-(x2,y2),fil,bf
  178. for i=0 to dv-1:line(dv+i+x1,(dv+1)+i+y1)-(dv+i+x1,dv-i+y2),fg:next i
  179. for i=0 to dv-1:line(dv-i+x2,(dv+1)+i+y1)-(dv-i+x2,dv-i+y2),bg:next i
  180. for i=0 to dv-1:line(dv+i+x1,dv+i+y1)-(dv-i+x2,dv+i+y1),fg:next i
  181. for i=0 to dv-1:line(dv-i+dv+x1,i+y2+1)-(dv+i-dv+x2,i+y2+1),bg:next i
  182.  
  183. end sub
  184.  
  185. sub redbox(byval y1, byval x1, byval y2,byval x2)
  186. RedTop=Y1
  187. RedLeft=X1
  188. RedBott=Y2
  189. RedRight=X2
  190. y1=(y1-1)*16-16:y2=(y2-1)*16+16:x1=(x1-1)*8-16:x2=(x2-1)*8+16
  191. fil=4:fg=12:bg=6:dv=5
  192. line(x1+dv,y1+dv)-(x2,y2),fil,bf
  193. for i=0 to dv-1:line(dv+i+x1,(dv+1)+i+y1)-(dv+i+x1,dv-i+y2),fg:next i
  194. for i=0 to dv-1:line(dv-i+x2,(dv+1)+i+y1)-(dv-i+x2,dv-i+y2),bg:next i
  195. for i=0 to dv-1:line(dv+i+x1,dv+i+y1)-(dv-i+x2,dv+i+y1),fg:next i
  196. for i=0 to dv-1:line(dv-i+dv+x1,i+y2+1)-(dv+i-dv+x2,i+y2+1),bg:next i
  197. end sub
  198.  
  199. sub CPrint(row%,col%,fc%,bc%, text$) static
  200. 'This routine sets the background Block Color
  201. c$=string$(len(text$),219)
  202. reg 1,&h1300
  203. reg 2,bc%:reg 3,len(text$)
  204. reg 4,256*(row%-1)+(col%-1)
  205. reg 9,strseg(c$)
  206. reg 7,strptr(c$)
  207. call interrupt &h10
  208.  
  209. 'This routine XOR's on the forground character color.
  210. reg 1,&h1300
  211. reg 2,(fc% xor bc%) + &h80
  212. reg 3,len(text$)
  213. reg 4,256*(row%-1)+(col%-1)
  214. reg 9,strseg(text$)
  215. reg 7,strptr(text$)
  216. call interrupt &h10
  217. end sub
  218.  
  219.  
  220. SUB YellowMESSAGE (byval X$)
  221.         IF LEFT$(X$,1)="+" THEN gN=0:X$=MID$(X$,2):YellowBOX YellowTop, YellowLeft, YellowBott, YellowRight
  222.         IF YellowTop + GN>YellowBott then GN=0
  223.         l=(YellowRight-Yellowleft)+1
  224.         IF LEN(X$)>L THEN X$=LEFT$(X$,L)
  225.         X$=SPACE$((L-LEN(X$))\2)+X$
  226.         CPRINT Yellowtop+gn, YellowLeft, 8,7,X$
  227.         INCR GN
  228. END SUB
  229.  
  230.  
  231. SUB RANDOM.VIDEO.EFFECT
  232.  
  233. i=480
  234. j=0
  235. n=1
  236.  
  237. do
  238. decr i,n
  239. incr j,n
  240. if i<240 then exit loop
  241. line (0,i) - (639,i), 9
  242. line (0,j) - (639,j), 9
  243. incr x:if x=3 then x=0:incr n
  244. loop
  245.  
  246. For i=639 TO 0 STEP -5
  247. LINE (639-i,0) - (i,479) , 3
  248. NEXT i
  249.  
  250.  
  251. END SUB
  252.  
  253. SUB SavePartScreen(x1,y1,x2,y2,a())
  254.     X = x2-x1+1
  255.     Y = y2-y1+1
  256.     B =  4 + CEIL(X/8)*4*Y
  257.     REDIM a(b)
  258.     Get (x1,y1)-(x2,y2),a
  259. END SUB
  260.  
  261. SUB RestorePartscreen(x1,y1,a())
  262.     PUT (x1,y1),a,pset
  263. END sub
  264.  
  265. SUB PCMAG
  266. dim ary1%(32000)
  267. dim ary2%(32000)
  268.  
  269. def seg=varseg(ary1%(0))
  270. bload "ED1",0
  271. def seg
  272.  
  273. def seg=varseg(ary2%(0))
  274. bload "ED2",0
  275. def seg
  276.  
  277. put(148,57),ary1%,pset
  278. put(148,223),ary2%,pset
  279.  
  280. END SUB
  281.  
  282. SUB GETPIC(F$, x%, y%)
  283. DIM A%(32700)
  284. DEF SEG = VARSEG(A%(0))
  285. BLOAD F$, 0
  286. PICBOX x%, y%, x%+A%(0), y%+A%(1)
  287. PUT (X%, Y%),A%
  288. END SUB
  289.  
  290. SUB CENTERPIC(F$)
  291. DIM A%(32700)
  292. DEF SEG = VARSEG(A%(0))
  293. BLOAD F$, 0
  294. x%=319 - (A%(0)\2)
  295. y%=200 - (A%(1)\2)
  296. PICBOX x%, y%, x%+A%(0), y%+A%(1)
  297. PUT (X%, Y%),A%
  298. END SUB
  299.  
  300. SUB LOWERPIC(F$)
  301.  DIM A%(32700)
  302.  DEF SEG = VARSEG(A%(0))
  303.  BLOAD F$, 0
  304.  x%=319 - (A%(0)\2)
  305.  y%=330 - (A%(1)\2)
  306.  PICBOX x%, y%, x%+A%(0), y%+A%(1)
  307.  PUT (X%, Y%),A%
  308. END SUB
  309.  
  310. sub picbox(byval x1, byval y1, byval x2,byval y2)
  311. fil=8:fg=15:bg=8:dv=5
  312. decr x1,10:decr y1,10
  313. decr x2:decr y2
  314. line(x1+dv,y1+dv)-(x2,y2),fil,bf
  315. for i=0 to dv-1:line(dv+i+x1,(dv+1)+i+y1)-(dv+i+x1,dv-i+y2),fg:next i
  316. for i=0 to dv-1:line(dv-i+x2,(dv+1)+i+y1)-(dv-i+x2,dv-i+y2),bg:next i
  317. for i=0 to dv-1:line(dv+i+x1,dv+i+y1)-(dv-i+x2,dv+i+y1),fg:next i
  318. for i=0 to dv-1:line(dv-i+dv+x1,i+y2+1)-(dv+i-dv+x2,i+y2+1),bg:next i
  319. end sub
  320.  
  321. SUB TYPEIN (Row%,X$)
  322. REPLACE "`" WITH CHR$(34) IN X$
  323. TP$(Row%)=X$
  324. FOR Col%=2 TO LEN(X$)+1
  325.     CPRINT Row%+4, Col%, 7,0,MID$(X$,Col%-1,1)
  326.         IF MID$(X$, Col%-1,1)<>" " THEN
  327.         CPRINT Row%+4, Col%+1, 7,0,"_"
  328.     'SOUND 400,.1
  329.         'SOUND 100,.1
  330.         'SOUND 50,.1
  331.     'DELAY .01
  332.         CPRINT Row%+4, Col%+1, 7,0," "
  333.     END IF
  334. NEXT Col%
  335. 'IF X$<>"" THEN
  336. 'SOUND 1000,.1
  337. 'FOR y%=1 TO 2
  338. 'CPRINT Row%+5, 2, 7,0,"_"
  339. 'DELAY .1
  340. 'CPRINT Row%+5, 2, 7,0," "
  341. 'DELAY .1
  342. 'NEXT y%
  343. 'END IF
  344. END SUB
  345.  
  346. SUB HILITE(Row%)
  347.     CPRINT Row%+4, 2, 15, 12, TP$(Row%)
  348. END SUB
  349.  
  350. SUB LOLITE(Row%)
  351.     CPRINT Row%+4, 2, 7, 0, TP$(Row%)
  352. END SUB
  353.  
  354. SUB IDEPIC (n%)
  355.     OPEN "COORD."+mid$(str$(n%),2) FOR INPUT AS #1
  356.         INPUT #1, x%, y%
  357.         CLOSE #1
  358.         y%=y%+32
  359.         REDIM Temp%(32700)
  360.         DEF SEG=VARSEG(Temp%(0))
  361.         BLOAD "IDEMENU."+mid$(str$(n%),2),0
  362.         PUT (x%, y%),Temp%,PSET
  363. END SUB
  364.  
  365. SUB BLACKOUT
  366. DIM BlackPal%(15)
  367. FOR P%=0 TO 15:BlackPal%(P%)=0:NEXT P%
  368. PALETTE USING BlackPal%(0)
  369. END SUB
  370.  
  371. SUB COPYRIGHT
  372. LINE (50,50)-(590,430),3,BF
  373. bluebox 8,25,22,55
  374. CPRINT 10,27,14,1,"    PowerBASIC Compiler"
  375. CPRINT 12,27,09,1,"       Version 3.00"
  376. CPRINT 14,27,09,1,"Copyright (C) 1989-1993 by"
  377. CPRINT 16,27,09,1,"       Robert Zale"
  378. CPRINT 18,27,09,1,"     PowerBASIC Inc."
  379. CPRINT 20,27,09,1,"   Brentwood, CA, USA"
  380. END SUB
  381.  
  382. SUB LOGO
  383. CPRINT 1,1,9,1,"  PowerBASIC 3.0 * Not your basic BASIC * Comdex demo (C) 1993 PowerBASIC Inc.  "
  384. GETSCREEN2 "IDE.12" 'a slightly modified version of GETSCREEN
  385. centerpic "PB.PIC"        ' LOGO
  386. END SUB
  387.  
  388. SUB INTRO
  389. GETSCREEN2 "IDE.12"
  390. centerpic "SCRIPT1.PIC"   ' INTRO
  391. END SUB
  392.  
  393. SUB TSR.TOPIC
  394. ' ********************************************************************
  395. '                              TSR TOPIC
  396. ' ********************************************************************
  397. GETSCREEN2 "IDE.12"
  398. centerpic "SCRIPT2.PIC"   ' PB CREATES TSR'S
  399. CWAIT .3
  400. GETSCREEN2 "IDE.12"
  401. TYPEIN 1,"Dummy& = SETMEM(-640000)   ' adjust memory"
  402. TYPEIN 2,"Dummy& = SETMEM(+4096)
  403. TYPEIN 3,"" 'blank lines are necessary for highlighter subroutine.
  404.             'if you don't specify a line is blank it will not clear
  405.             'highlighter memory and an old line may show through
  406. TYPEIN 4,"POPUP KEY CHR$(8,1,&H70)   ' pop up on ALT-ESC"
  407. TYPEIN 6,"DO"
  408. TYPEIN 7,""
  409. TYPEIN 8,"        POPUP SLEEP USING EMS, `C:\SWAP.$$$`"
  410. TYPEIN 9,""
  411. TYPEIN 10,"        PRINT `Hello there, I'm a TSR!`"
  412. TYPEIN 11,""
  413. TYPEIN 12,"LOOP"
  414. HILITE 1
  415. HILITE 2
  416. YELLOWBOX 17,20,17,62
  417. YELLOWMESSAGE "+Use SETMEM to set memory requirements"
  418. CWAIT .05
  419. LOLITE 1
  420. LOLITE 2
  421.  
  422. HILITE 4
  423. YELLOWMESSAGE "+Set method of POPUP. Here we use a hot key"
  424. CWAIT .05
  425. LOLITE 4
  426.  
  427. HILITE 6
  428. HILITE 12
  429. YELLOWMESSAGE "+Place a loop around the important code"
  430. CWAIT .05
  431. LOLITE 6
  432. LOLITE 12
  433.  
  434. HILITE 8
  435. YELLOWMESSAGE "+Program goes resident here to a 5K kernel"
  436. CWAIT .05
  437. LOLITE 8
  438.  
  439. HILITE 10
  440. YELLOWMESSAGE "+...And this is what our TSR program does!"
  441. CWAIT .05
  442. END SUB
  443.  
  444.  
  445. SUB ASM.TOPIC
  446. ' ********************************************************************
  447. '                      ASSEMBLY LANGUAGE TOPIC
  448. ' ********************************************************************
  449. 'Here:
  450. GETSCREEN2 "IDE.12"
  451. centerpic "SCRIPT3.PIC"  ' BUILT IN ASSEMBLY LANGUAGE
  452. CWAIT .3
  453. GETSCREEN2 "IDEZOOM.12"
  454. YELLOWBOX 27,10,27,70
  455. YELLOWMESSAGE "+Inline assembly language makes ASM integration a breeze"
  456. TYPEIN  1,"        FUNCTION SumInteger&(x%,y%)"
  457. TYPEIN  2,"          LOCAL temp&              ' a place to save the result"
  458. TYPEIN  3,"          ASM   push ds            ; ds must be preserved"
  459. TYPEIN  4,"          ASM   xor  ax, ax        ; zero the low-order result"
  460. TYPEIN  5,"          ASM   xor  dx, dx        ; zero the high-order result"
  461. TYPEIN  6,"          ASM   lds  bx, y%        ; get a pointer to the count"
  462. TYPEIN  7,"          ASM   mov  cx, [bx]      ; cx = count of array elements"
  463. TYPEIN  8,"          ASM   lds  bx, x%        ; ds:[bx] = pointer to element 1"
  464. TYPEIN  9,"          ASM   jcxz sum2          ; in case of no elements"
  465. TYPEIN 10,"        SUM1:"
  466. TYPEIN 11,"          ASM   add  ax, ds:[bx]   ; add in one integer"
  467. TYPEIN 12,"          ASM   adc  dx, 0         ; account for integer overflow"
  468. TYPEIN 13,"          ASM   add  bx, 2         ; point to the next integer"
  469. TYPEIN 14,"          ASM   loop sum1          ; repeat as needed"
  470. TYPEIN 15,"        SUM2:"
  471. TYPEIN 16,"          ASM   pop  ds            ; restore the caller's register"
  472. TYPEIN 17,"          ASM   mov  temp&[00], ax ; save the low-order result"
  473. TYPEIN 18,"          ASM   mov  temp&[02], dx ; save the high-order result"
  474. TYPEIN 19,"          SumInteger& = temp&      ; transfer it to the Basic var"
  475. TYPEIN 20,"        END FUNCTION"
  476. HILITE 6:HILITE 8:HILITE 9:HILITE 14:HILITE 17:HILITE 18
  477. YELLOWMESSAGE "+Access BASIC labels and variables directly in ASM statements"
  478. CWAIT .1
  479. LOLITE 6:LOLITE 8:LOLITE 9:LOLITE 14:LOLITE 17:LOLITE 18
  480. YELLOWMESSAGE "+Single-step and trace each ASM statement just like BASIC"
  481. FOR A=1 TO 20:HILITE A:DELAY .2:LOLITE A:NEXT A
  482. IDEPIC 13:IDEPIC 14 ' get register display
  483. YELLOWBOX 27,10,27,70
  484. YELLOWMESSAGE "+The debugging environment even offers full CPU register watch"
  485. CWAIT .1
  486. END SUB
  487.  
  488. SUB DAT.TOPIC
  489. GETSCREEN2 "IDE.12"
  490. centerpic "SCRIPT4.PIC"
  491. CWAIT .2
  492. GETSCREEN2 "IDEZOOM.12"
  493. TYPEIN 1, " Variable type          char    size     64K array       DEF-    Keyword   "
  494. TYPEIN 2, " --------------------------------------------------------------------------"
  495. TYPEIN 3, " Integers                                                                  "
  496. TYPEIN 4, "         Integer         %       2       32,767          DEFINT  INTEGER   "
  497. TYPEIN 5, "         Long integer    &       4       16,383          DEFLNG  LONG      "
  498. TYPEIN 6, "         Quad integer    &&      8        8,191          DEFQUD  QUAD      "
  499. TYPEIN 7, " Unsigned integers                                                         "
  500. TYPEIN 8, "         Byte            ?       1       65,535          DEFBYT  BYTE      "
  501. TYPEIN 9, "         Word            ??      2       32,767          DEFWRD  WORD      "
  502. TYPEIN 10,"         Double Word     ???     4       16,383          DEFDWRD DWORD     "
  503. TYPEIN 11," Floating point                                                            "
  504. TYPEIN 12,"         Single          !       4       16,383          DEFSNG  SINGLE    "
  505. TYPEIN 13,"         Double          #       8        8,191          DEFDBL  DOUBLE    "
  506. TYPEIN 14,"         Extended        ##      10       6,553          DEFEXT  EXT       "
  507. TYPEIN 15,"         BCD fixed       @       8        8,191          DEFFIX  FIX       "
  508. TYPEIN 16,"         BCD floating    @@      10       6,553          DEFBCD  BCD       "
  509. TYPEIN 17," Strings                                                                   "
  510. TYPEIN 18,"         String          $       2       32,767          DEFSTR  STRING    "
  511. TYPEIN 19,"         Flex String     $$      2       32,767          DEFFLX  FLEX      "
  512. TYPEIN 20,"         Fixed-Length    N/A     (depends on size)               STRING * x"
  513. YELLOWBOX 27,9,27,71
  514. HILITE 8:HILITE 9:HILITE 10
  515. YELLOWMESSAGE "+Unsigned integers!  A first for PowerBASIC"
  516. CWAIT .05
  517. LOLITE 8:LOLITE 9:LOLITE 10
  518.  
  519. HILITE 12:HILITE 13:HILITE 14:HILITE 15:HILITE 16
  520. YELLOWMESSAGE "+PowerBASIC offers an extended set of floating point data types"
  521. CWAIT .05
  522. LOLITE 12:LOLITE 13:LOLITE 14:LOLITE 15:LOLITE 16
  523.  
  524. HILITE 19
  525. YELLOWMESSAGE "dynamic structures that can be allocated on the fly or erased"
  526. CWAIT .05
  527. LOLITE 19
  528. CENTERPIC "SCRIPT5.PIC"
  529. CWAIT .2
  530. GETSCREEN2 "IDE.12"
  531. TYPEIN 1,""
  532. TYPEIN 2,"        TYPE XModemPacketType"
  533. TYPEIN 3,"                SOH AS BYTE"
  534. TYPEIN 4,"                BLK AS BYTE"
  535. TYPEIN 5,"                NEG AS BYTE"
  536. TYPEIN 6,"                DAT AS STRING * 128"
  537. TYPEIN 7,"                CRC AS WORD"
  538. TYPEIN 8,"        END TYPE"
  539. TYPEIN 9,""
  540. TYPEIN 10,"        UNION XModemUnion"
  541. TYPEIN 11,"                Packet AS XmodemPacketType"
  542. TYPEIN 12,"                Block  AS STRING * 133"
  543. TYPEIN 13,"        END UNION"
  544. TYPEIN 14,""
  545. TYPEIN 15,"        DIM XModem AS XModemUnion"
  546.  
  547. YELLOWBOX 27,9,27,71
  548. HILITE 2:HILITE 3:HILITE 4:HILITE 5:HILITE 6:HILITE 7:HILITE 8
  549. YELLOWMESSAGE "+User defined data structures"
  550. CWAIT .05
  551. LOLITE 2:LOLITE 3:LOLITE 4:LOLITE 5:LOLITE 6:LOLITE 7:LOLITE 8
  552.  
  553. HILITE 10:HILITE 11:HILITE 12:HILITE 13
  554. YELLOWMESSAGE "+User defined UNIONs of data types and data structures"
  555. CWAIT .05
  556. LOLITE 10:LOLITE 11:LOLITE 12:LOLITE 13
  557. END SUB
  558.  
  559. SUB ARR.TOPIC
  560. ' ********************************************************************
  561. '                        ARRAY OPERATIONS
  562. ' ********************************************************************
  563. GETSCREEN2 "IDE.12"
  564. centerpic "SCRIPT6.PIC"
  565. CWAIT .1
  566. GETSCREEN2 "IDEZOOM.12"
  567. TYPEIN 1,"        DIM DoubleArray#(100)"
  568. TYPEIN 2,"        DIM A(10000) AS INTEGER"
  569. TYPEIN 3,""
  570. TYPEIN 4,"        DIM HUGE B$(10000)"
  571. TYPEIN 5,""
  572. TYPEIN 6,"        DIM ABSOLUTE BDA%(1024) AT 0"
  573. TYPEIN 7,""
  574. TYPEIN 8,"        TYPE VideoChars"
  575. TYPEIN 9,"                Char AS BYTE"
  576. TYPEIN 10,"                Attr AS BYTE"
  577. TYPEIN 11,"        END TYPE"
  578. TYPEIN 12,""
  579. TYPEIN 13,"        DIM ABSOLUTE Vid(2000) AS VideoChars AT &HB800"
  580. TYPEIN 14,""
  581. TYPEIN 15,"        ARRAY SORT Vid()"
  582. TYPEIN 16,"        ARRAY SORT B$(0) FOR 10000,COLLATE UCASE,TAGARRAY A(),COLLATE UCASE"
  583. TYPEIN 17,""
  584. TYPEIN 18,"        ARRAY SCAN B$(0) FOR 10000,COLLATE UCASE,=`TRESPASSERS WIL`, TO i%"
  585. YELLOWBOX 27,10,27,70
  586. HILITE 1:HILITE 2
  587. YELLOWMESSAGE "+DIMension normal arrays just like always"
  588. CWAIT .05
  589. LOLITE 1:LOLITE 2
  590. HILITE 4
  591. YELLOWMESSAGE "+HUGE arrays can be as large as 640K, and any data type"
  592. CWAIT .05
  593. LOLITE 4
  594. HILITE 6
  595. YELLOWMESSAGE "+An ABSOLUTE array can be fixed to any segment boundary"
  596. CWAIT .05
  597. LOLITE 6
  598. HILITE 8:HILITE 9:HILITE 10:HILITE 11:HILITE 12:HILITE 13
  599. YELLOWMESSAGE "+Here is an array of structures which overlap video RAM"
  600. CWAIT .05
  601. LOLITE 8:LOLITE 9:LOLITE 10:LOLITE 11:LOLITE 12:LOLITE 13
  602. HILITE 15:HILITE 16
  603. YELLOWMESSAGE "+Arrays of any data type can be sorted internally"
  604. CWAIT .05
  605. LOLITE 15:LOLITE 16
  606. HILITE 18
  607. YELLOWMESSAGE "+You can also SCAN for, INSERT or DELETE elements"
  608. CWAIT .05
  609. LOLITE 18
  610. END SUB
  611.  
  612. SUB MAT.TOPIC
  613. ' ********************************************************************
  614. '                        FAST MATH
  615. ' ********************************************************************
  616. GETSCREEN2 "IDEMATH.12"
  617. lowerpic "SCRIPT7.PIC"
  618. CWAIT .2
  619. END SUB
  620.  
  621. SUB MSC.TOPIC
  622. ' ********************************************************************
  623. '                        BASIC FIRSTS
  624. ' ********************************************************************
  625. GETSCREEN2 "IDECODE.12"
  626. centerpic "SCRIPT8.PIC"
  627. CWAIT .2
  628.  
  629.  
  630. ' ********************************************************************
  631. '                        STRUCTURE
  632. ' ********************************************************************
  633. GETSCREEN2 "IDESTRU.12"
  634. lowerpic "SCRIPT9.PIC"
  635. CWAIT .2
  636.  
  637.  
  638. ' ********************************************************************
  639. '                           BIT OPERATIONS
  640. ' ********************************************************************
  641. GETSCREEN2 "IDECODE.12"
  642. centerpic "SCRIPT10.PIC"
  643. CWAIT .1
  644. END SUB
  645.  
  646.  
  647. SUB COM.TOPIC
  648. ' ********************************************************************
  649. '                              COMMUNICATIONS
  650. ' ********************************************************************
  651.  
  652. 'GETSCREEN2 "IDE.12"
  653. 'centerpic "SCRIPT11.PIC"
  654. 'CWAIT .2
  655. getscreen2 "IDE.12"
  656. TYPEIN  1,"'      *** bridge PC modem with a terminal in a background task              "
  657. TYPEIN  2,"SetPort 4, &H2E0                                 'Poke any port into BIOS    "
  658. TYPEIN  3,"OPEN `COM4:115200,N,8,1,ME,FE,IR5` AS #1         'Open multi-port channel 1  "
  659. TYPEIN  4,"OPEN `COM2:9600,N,8,1,RS,CS` AS #2               'Open ordinary port at 9600 "
  660. TYPEIN  5,"OPEN `CONS:` FOR OUTPUT AS #3                    'Open console for ANSI print"
  661. TYPEIN  6,"DO                                               '                           "
  662. TYPEIN  7,"    A$=INKEY$                                    'get local key              "
  663. TYPEIN  8,"    IF LOC(#1) THEN A$=INPUT$(LOC(#1),#1)        'get key from terminal      "
  664. TYPEIN  9,"    IF LEN(A$) THEN                              '                           "
  665. TYPEIN 10,"        A$=REMOVE$(A$,CHR$(10))                  'filter line-feeds          "
  666. TYPEIN 11,"        REPLACE CHR$(13) WITH CHR$(13,10) IN A$  '                           "
  667. TYPEIN 12,"        PRINT #2, A$;                            'send key to modem          "
  668. TYPEIN 13,"    END IF                                       '                           "
  669. TYPEIN 14,"    IF LOC(#2) THEN A$=INPUT$(LOC(#2),#2)        'check modem for data       "
  670. TYPEIN 15,"        PRINT #2, A$;                            'send it to terminal        "
  671. TYPEIN 16,"        PRINT #3, A$;                            'send it to screen          "
  672. TYPEIN 17,"    END IF                                       '                           "
  673. TYPEIN 18,"LOOP                                             'do this forever            "
  674.  
  675. yellowbox 24,9,25,71
  676. HILITE 2
  677. YELLOWMESSAGE "+COM port addresses are taken from the BIOS data area, not"
  678. YELLOWMESSAGE "hard coded.  This means you can change them this easily"
  679. CWAIT .12
  680. LOLITE 2
  681. HILITE 3:HILITE 4
  682. YELLOWMESSAGE "+Open multiple ports at the highest speeds, mask and flush"
  683. YELLOWMESSAGE "I/O errors and select the IRQ for nonstandard serial boards"
  684. CWAIT .12
  685. LOLITE 3:LOLITE 4
  686. HILITE 10:HILITE 11
  687. YELLOWMESSAGE "+PowerBASIC's advanced string functions can go further than"
  688. YELLOWMESSAGE "this.  Even complex emulation is no longer an assembler chore"
  689. CWAIT .12
  690. END SUB
  691.  
  692. SUB IDE.TOPIC
  693. ' ********************************************************************
  694. '                                NEW IDE
  695. ' ********************************************************************
  696. GETSCREEN2 "IDE.12"
  697. centerpic "SCRIPT12.PIC"
  698. CWAIT .3
  699. GETSCREEN2 "IDEINFO.12"
  700. CPRINT 22,20,7,4,SPACE$(40) ' cover up the "press any key" on the screen
  701. YELLOWBOX 25,9,26,71
  702. YELLOWMESSAGE "+PowerBASIC's compiler info screen outlines compiler"
  703. YELLOWMESSAGE "and executable memory useage"
  704. CWAIT .07
  705. CPRINT  9,16,10,7,"Lines:     1665     Time: 00:04.4"
  706. CPRINT 10,16,10,7,"Stmts:     1507     22200 lines/minute"
  707. YELLOWMESSAGE "+PowerBASIC is well known for its"
  708. YELLOWMESSAGE "blistering-fast compile times"
  709. CWAIT .07
  710. CPRINT  9,16,0,7, "Lines:     1665     Time: 00:04.4"
  711. CPRINT 10,16,0,7, "Stmts:     1507     22200 lines/minute"
  712.  
  713. CPRINT 17,16,10,7,"Ems:      1216k     Total compiler memory: 3232k"
  714. CPRINT 18,16,10,7,"Xms:      1792k     Free compiler memory:  3056k"
  715. YELLOWMESSAGE "+PowerBASIC takes advantage of EMS, XMS or virtual disk"
  716. YELLOWMESSAGE "memory for the largest possible compiles in a single step"
  717. CWAIT .07
  718.  
  719. GETSCREEN2 "IDECOLOR.12"
  720. YELLOWBOX 25,12,25,68
  721. YELLOWMESSAGE "+Development environment colors are fully configurable"
  722. CWAIT .07
  723. GETSCREEN2 "IDEKEYS.12
  724. YELLOWBOX 25,12,25,68
  725. YELLOWMESSAGE "+You may also create and modify I.D.E. hot keys"
  726. CWAIT .05
  727. GETSCREEN2 "IDE.12"
  728. LOWERPIC "PB.PIC"
  729. FOR i%=1 TO 7
  730. GETSCREEN3 "IDE.12"
  731. IDEPIC i%
  732. DELAY 1
  733. NEXT i%
  734. GETSCREEN2 "IDE.12"
  735. CENTERPIC "PB.PIC"
  736. DELAY 1
  737. END SUB
  738.  
  739. sub greybox(byval y1, byval x1, byval y2,byval x2)
  740. GreyTop=Y1
  741. GreyLeft=X1
  742. GreyBott=Y2
  743. GreyRight=X2
  744. y1=(y1-1)*16-16:y2=(y2-1)*16+16:x1=(x1-1)*8-16:x2=(x2-1)*8+16
  745. fg=15:bg=8:dv=5
  746. line (x1+dv,y1+dv)-(x2,y2),7,bf
  747. for i=0 to dv-1:line(dv+i+x1,(dv+1)+i+y1)-(dv+i+x1,dv-i+y2),fg:next i
  748. for i=0 to dv-1:line(dv-i+x2,(dv+1)+i+y1)-(dv-i+x2,dv-i+y2),bg:next i
  749. for i=0 to dv-1:line(dv+i+x1,dv+i+y1)-(dv-i+x2,dv+i+y1),fg:next i
  750. for i=0 to dv-1:line(dv-i+dv+x1,i+y2+1)-(dv+i-dv+x2,i+y2+1),bg:next i
  751. end sub
  752.  
  753. FUNCTION FUTURE$(X$)
  754.     FOR y%=1 TO LEN(X$)
  755.         x%=ASCII(MID$(X$,y%,1))
  756.         IF x%>64 AND x%<91 THEN x%=x%-64
  757.         Z$=Z$+CHR$(x%)
  758.         NEXT y%
  759.         FUTURE$=Z$
  760. END FUNCTION
  761.  
  762. FUNCTION COMPUTER$(X$)
  763.     FOR y%=1 TO LEN(X$)
  764.         x%=ASCII(MID$(X$,y%,1))
  765.         IF x%>64 AND x%<91 THEN x%=x%+63
  766.         Z$=Z$+CHR$(x%)
  767.         NEXT y%
  768.         COMPUTER$=Z$
  769. END FUNCTION
  770.  
  771. FUNCTION ROMAN$(X$)
  772.     FOR y%=1 TO LEN(X$)
  773.         x%=ASCII(MID$(X$,y%,1))
  774.         IF x%<128 THEN x%=x%+127
  775.         Z$=Z$+CHR$(x%)
  776.         NEXT y%
  777.         ROMAN$=Z$
  778. END FUNCTION
  779.  
  780. SUB GreyMESSAGE (byval X$)
  781.         IF LEFT$(X$,1)="+" THEN gN=0:X$=MID$(X$,2):GreyBOX GreyTop, GreyLeft, GreyBott, GreyRight
  782.         IF LEN(X$) THEN C$=LEFT$(X$,2):X$=MID$(X$,3)
  783.         IF GreyTop + GN>GreyBott then GN=0
  784.         l=(GreyRight-Greyleft)+1
  785.         IF LEN(X$)>L THEN X$=LEFT$(X$,L)
  786.         X$=SPACE$((L-LEN(X$))\2)+X$
  787.         CPRINT GreyTop+GN, GreyLeft, val(c$),7,X$
  788.         INCR GN
  789. END SUB
  790.  
  791. SUB ADD.TOPIC
  792. ' ********************************************************************
  793. '                                THIRD PARTY
  794. ' ********************************************************************
  795. SCREEN 12
  796. GETSCREEN2 "IDE.12"
  797. centerpic "SCRIPT13.PIC"
  798. CWAIT .05
  799. greybox 6,4,21,77
  800. OPEN "TOOLS" FOR INPUT AS #1
  801. DO UNTIL EOF(1)
  802.     INPUT #1, A$
  803.         IF A$="CWAIT" THEN CWAIT .05
  804.         GREYMESSAGE A$
  805.     A$=INKEY$:IF A$=" " THEN DO:A$=INKEY$:LOOP UNTIL A$<>""
  806.         IF A$=CHR$(27) THEN END
  807.     IF LEN(A$) THEN EXIT LOOP
  808. LOOP
  809. CWAIT .05
  810. END SUB
  811.  
  812. SUB HEL.TOPIC
  813. GETSCREEN2 "IDEHELP.12"
  814. delay 1
  815. lowerpic "SCRIPT14.PIC"
  816. CWAIT .2
  817. GETSCREEN2 "IDEHELP.12"
  818. DELAY 1
  819. GETSCREEN2 "IDE.12"
  820. END SUB